home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Tools 4
/
Amiga Tools 4.iso
/
tools
/
mail-tools
/
thor
/
thor_2.22
/
thor.lha
/
rexx
/
GetEMail.thor
< prev
next >
Wrap
Text File
|
1995-12-18
|
5KB
|
184 lines
/*
$VER: GetEmail.Thor 1.4 by Remco van Hooff
Rips email addresses out of the current message, and
optionaly saves them to the userlist of your Email system.
------------------------- HISTORY -------------------------
1.0 - First release
1.1 - Some little cosmetic fixes
1.2 - Fixed a parsing bug, now addresses at the beginning
of a line are parsed ok.
1.3 - Added checking if there is more than one address on
one a line, so all addresses should be found now.
1.4 - Ajusted the script with the new Thor 2.1 arexx
commands. No more RexxReqTools.library needed.
------------------------- CREDITS -------------------------
Jon Ward, for the idea.
-----------------------------------------------------------
*/
bbs = 'Email' /* your Email system */
if ~show('l','rexxsuppport.library') then call addlib('rexxsupport.library',0,-30,0)
drop USER.
tempfile = 't:email.tmp'
options failat 31
p = address() || ' ' || show('P',,)
thorport = pos('THOR.',p)
if thorport > 0 then thorport = word(substr(p,thorport),1)
else do
say 'THOR port not found!'
exit 10
end
if ~show('p', 'BBSREAD') then do
address command
"run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
"WaitForPort BBSREAD"
end
address(thorport)
options results
saved = 0
SAVEMESSAGE CURRENT FILENAME tempfile NOHEADER NOANSI OVERWRITE
if(rc ~= 0) then do
'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
exit
end
else do
call open(tmp,tempfile,'r')
msg = readch(tmp,102400)
check = pos('@', msg)
if check = 0 then do
'requestnotify text "No Email address found." bt "_OK"'
signal abort
end
call close(tmp)
if check ~= 0 then do
call open(tmp, tempfile, 'r')
do while ~eof(tmp)
msg = readln(tmp)
parse var msg part1 '@' part2 '.' part3 rest
do forever
if part2 ~= '' then do
spc = lastpos(' ', part1)
if spc ~= 0 then part1 = delstr(part1, 1, spc)
lengte = length(part3)
call filter(part3, lengte)
vraag = 'Add this Email address to\nthe' bbs 'userdatabase?'
ttl = 'the' bbs 'userdatabase?'
if ((lengte2 > length(bbs)+18) & (lengte2 > 26)) then vraag = center('Add this Email address to',lengte2,' ')||'\n'||center(ttl,lengte2,' ')
/* remember that filling up with spaces only works correct if you use a non proportional font */
REQUESTSTRING title '"GetEmail"' body '"'vraag'"' BT '"_Add|_Quit|S_kip"' ID '"'email'"'
email = result
if thorrc = 1 then do
call ask
end
if thorrc = 2 then do
signal abort
end
end
if pos('@', rest) ~= 0 then do
parse var rest part1 '@' part2 '.' part3 rest
empty = 0
end
else empty = 1
if empty = 1 then leave
end
end
call close(tmp)
end
call delete(tempfile)
'requestnotify text "No more Email addresses found." bt "_OK"'
end
exit
ask:
address(thorport)
do forever
REQUESTSTRING title '"GetEmail"' BT '"_Ok|_Cancel"' body '"Enter owner of the address\n'email'."' ID '"'part1'"'
if rc=30 then do
REQUESTNOTIFY '"'THOR.LASTERROR'"' '"_Ok"'
call abort
end
username = result
if rc = 0 then leave
end
'REQUESTSTRING title "GetEmail" body "Enter an alias for\n'username':" BT "_Ok|_Cancel" MAXCHARS=100'
if rc = 0 then useralias = result
if rc = 5 then useralias = ''
'REQUESTSTRING title "GetEmail" body "Enter a comment:" BT "_Ok|_Cancel" MAXCHARS=100'
if rc = 0 then usercomment = result
if rc = 5 then usercomment = ''
'REQUESTNOTIFY "Name : 'username'\nAddr : 'email'\nAlias: 'useralias'\nComnt: 'usercomment'\n\nAdd this user to system' bbs'?"' '"_Yes|_No"'
if rc~=0 then do
REQUESTNOTIFY '"THOR.LASTERROR"' '"_Ok"'
call abort
end
if result ~= 0 then do
address BBSREAD
USER.NAME = username
USER.ADDRESS = email
USER.ALIAS = useralias
USER.COMMENT.1 = usercomment
if USER.COMMENT.1 = '' then USER.COMMENT.COUNT = 0; else USER.COMMENT.COUNT = 1
WRITEBRUSER bbsname '"'bbs'"' stem USER ONLYIFEXIST
if rc~=0 then do
address(thorport)
REQUESTNOTIFY '"'BBSREAD.LASTERROR'"' '"_Ok"'
call abort
end
end
return
filter:
adres = arg(1)
lngth = arg(2)
lf = '0a'x
lnfd = pos(lf, adres)
if lnfd ~=0 then do
adres = delstr(adres, lnfd)
end
haak = lastpos(')', adres)
if haak ~=0 then do
adres = delstr(adres, haak)
end
hook = lastpos('>', adres)
if hook ~=0 then do
adres = delstr(adres, hook)
end
komma = pos(',', adres)
if komma ~= 0 then do
adres = delstr(adres, komma)
end
quote = pos("'", adres)
if quote ~= 0 then do
adres = delstr(adres, quote)
end
dquote = pos('"', adres)
if dquote ~= 0 then do
adres = delstr(adres, dquote)
end
email = part1'@'part2'.'adres
lengte2 = length(email)
return
abort:
call close(tmp)
call delete(tempfile)
exit